﻿Imports System.IO
Imports System.Net.Sockets
Imports System.Text
Imports System.Text.RegularExpressions

Public Class Form7
    Private Function GetMailServer(ByVal sDomain As String) As String
        Dim info As New ProcessStartInfo()
        Dim ns As Process
        ' 调用Windows的nslookup命令，查找邮件服务器
        info.UseShellExecute = False
        info.RedirectStandardInput = True
        info.RedirectStandardOutput = True
        info.FileName = "nslookup"
        info.CreateNoWindow = True
        ' 查找类型为MX。关于nslookup的详细说明，请参见
        ' Windows帮助
        info.Arguments = "-type=MX " + sDomain.ToUpper.Trim
        ' 启动一个进行执行Windows的nslookup命令()
        ns = Process.Start(info)
        Dim sout As StreamReader
        sout = ns.StandardOutput
        '  利用正则表达式找出nslookup命令输出结果中的邮件服务器信息
        Dim reg As Regex = New Regex(" mail exchanger = (?<server>[^/s]+)")
        Dim mailserver As String = ""
        Dim response As String = ""
        Do While (sout.Peek() > -1)
            response = sout.ReadLine()
            Dim amatch As Match = reg.Match(response)
            If (amatch.Success) Then
                mailserver = amatch.Groups("server").Value
                Exit Do
            End If
        Loop
        Return mailserver
    End Function


    Public Function CheckEmail(ByVal sEmail As String, Optional ByVal sPort As Integer = 25) As Byte
        Dim oStream As NetworkStream
        Dim sFrom As String   ' 发件人
        Dim sTo As String   ' 收件人
        Dim sResponse As String   ' 邮件服务器的应答
        Dim Remote_Addr As String   ' 发件人的域名
        Dim mserver As String   ' 邮件服务器
        Dim sText As String()

        sTo = "<" + sEmail + ">"
        '  从邮件地址分离出帐户名和域名
        sText = sEmail.Split(CType("@", Char))
        '  查找该域的邮件服务器
        mserver = GetMailServer(sText(1))
        ' mserver为空值表明查找邮件服务器失败
        If mserver = "" Then
            Return 4
            Exit Function
        End If
        ' 发件人地址的域名必须合法
        Remote_Addr = "sina.com.cn"
        sFrom = "<myIP@ " & Remote_Addr + ">"
        ' 尽可能延迟创建对象的时间
        Dim oConnection As New TcpClient()
        Try
            ' 超时时间
            oConnection.SendTimeout = 5000
            ' 连接SMTP端口
            oConnection.Connect(mserver, sPort)
            ' 收集邮件服务器的应答信息
            oStream = oConnection.GetStream()
            sResponse = GetData(oStream)
            sResponse = SendData(oStream, "HELO " & Remote_Addr & vbCrLf)
            sResponse = SendData(oStream, "MAIL FROM:" & sFrom & vbCrLf)
            ' 如果对MAIL FROM指令有肯定的应答，
            ' 至少表明邮件地址的域名正确
            If ValidResponse(sResponse) Then
                sResponse = SendData(oStream, "RCPT TO:" & sTo & vbCrLf)
                ' 如果对RCPT TO指令有肯定的应答
                ' 表明邮件服务器已认可该地址
                If ValidResponse(sResponse) Then
                    Return 1   ' 邮件地址有效
                Else
                    Return 2   ' 只有域名有效
                End If
            End If
            ' 结束与邮件服务器的会话
            SendData(oStream, "QUIT" & vbCrLf)
            oConnection.Close()
            oStream = Nothing
        Catch
            Return 3   ' 错误！
        End Try
    End Function

    ' 获取服务器应答数据，并将其转换为String
    Private Function GetData(ByRef oStream As NetworkStream) As String

        Dim bResponse(1024) As Byte
        Dim sResponse As String = ""

        Dim lenStream As Integer = oStream.Read(bResponse, 0, 1024)
        If lenStream > 0 Then
            sResponse = Encoding.ASCII.GetString(bResponse, 0, 1024)
        End If
        Return sResponse
    End Function
    ' 向邮件服务器发送数据
    Private Function SendData(ByRef oStream As NetworkStream, ByVal sToSend As String) As String
        Dim sResponse As String
        ' 将String转换成Byte数组
        Dim bArray() As Byte = Encoding.ASCII.GetBytes(sToSend.ToCharArray)
        ' 发送数据
        oStream.Write(bArray, 0, bArray.Length())
        sResponse = GetData(oStream)
        ' 返回应答
        Return sResponse
    End Function

    ' 服务器是否返回肯定的回答？
    Private Function ValidResponse(ByVal sResult As String) As Boolean
        Dim bResult As Boolean
        Dim iFirst As Integer
        If sResult.Length > 1 Then
            iFirst = CType(sResult.Substring(0, 1), Integer)
            ' 如果服务器返回应答的第一个字符小于'3'
            ' 我们认为服务器已认可刚才的操作
            If iFirst < 3 Then bResult = True
        End If
        Return bResult
    End Function

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim ss = CheckEmail(TextBox1.Text)
        Console.WriteLine(ss)
    End Sub
End Class
